home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ARK.ARJ / MOUSE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-03  |  4.0 KB  |  216 lines
  1. { Questa unit e' stata importata esternamente da altre fonti }
  2. { e non fa parte del sorgente pascal scritto dall'autore.    }
  3.  
  4.  
  5. unit mouse; { and other interesting stuff }
  6. {$F+}
  7.  
  8. interface
  9.  
  10. procedure hidemouse;
  11. procedure memcpy(source,destination : pointer; size : word);
  12. procedure memzerocpy(source,destination : pointer; size : word);
  13. procedure mousecoords(var x,y : integer);
  14. procedure mousemove(x,y : integer);
  15. procedure mousereset;
  16. procedure mouse_x_limit(mn,mx : integer);
  17. procedure mouse_y_limit(mn,mx : integer);
  18. procedure showmouse;
  19.  
  20. procedure mydelay(time : longint);
  21.  
  22. function mouseclick:integer;
  23. function longtime : longint;
  24.  
  25. implementation
  26. uses dos;
  27.  
  28.  
  29.  
  30. (* Copies "size" bytes from "source" to "destination".       *)
  31. (* The operator addr may be used to pass the correct adress. *)
  32.  
  33. (* Example: memcpy(addr(source),addr(destination),200)       *)
  34. (* where:   source,destination : array[...] of bytes;        *)
  35. (*          200 is the number of bytes to be copied          *)
  36.  
  37. procedure memcpy(source,destination : pointer; size : word);
  38. label LP;
  39.    begin
  40.      asm
  41.      push ds
  42.      push si
  43.  
  44.      mov cx,size
  45.      lds si,source
  46.      les di,destination
  47.  
  48.      LP:
  49.      lodsb
  50.      stosb
  51.      loop LP
  52.  
  53.      pop si
  54.      pop ds
  55.      end;
  56.    end;
  57.  
  58. (* Does exactly the same as memcpy except that it does not copies *)
  59. (* those bytes whose value is 0. It's useful to put on the screen *)
  60. (* drawings using color 0 as trasparent.                          *)
  61.  
  62. procedure memzerocpy(source,destination : pointer; size : word);
  63. label LP,L1,L2,L3;
  64.    begin
  65.      asm
  66.      push ds
  67.      push si
  68.  
  69.      mov cx,size
  70.      mov dx,0
  71.      lds si,source
  72.      les di,destination
  73.  
  74.      LP:
  75.      lodsb
  76.      cmp al,dl
  77.      je  L2
  78.  
  79.      L1:
  80.      stosb
  81.      jmp L3
  82.  
  83.      L2:
  84.      inc di
  85.  
  86.      L3:
  87.      loop LP
  88.  
  89.      pop si
  90.      pop ds
  91.      end;
  92.    end;
  93.  
  94.  
  95. (* Return a value between 0 and 8640000 depending on current time *)
  96. function longtime : longint;
  97. var h,m,s,c : word;
  98.     h1,m1,
  99.     s1,c1   : longint;
  100.  
  101.     begin
  102.     gettime(h,m,s,c);
  103.  
  104.     h1:=h;
  105.     m1:=m;
  106.     s1:=s;
  107.     c1:=c;
  108.  
  109.     longtime:=c1+s1*100+m1*6000+h1*360000;
  110.     end;
  111.  
  112. (* It's the equivalent of DELAY except that it's based on hardware time     *)
  113. (* and not on clock ticks. If some one alters the CPU speed using the TURBO *)
  114. (* button MYDELAY is not affected. This is not the same for DELAY.          *)
  115.  
  116. procedure mydelay(time : longint);
  117. var h,m,s,c : word;
  118.     a,b,
  119.     h1,m1,
  120.     s1,c1   : longint;
  121.  
  122.     begin
  123.     gettime(h,m,s,c);
  124.  
  125.     h1:=h;
  126.     m1:=m;
  127.     s1:=s;
  128.     c1:=c;
  129.  
  130.     a:=c1+s1*100+m1*6000+h1*360000;
  131.  
  132.     repeat
  133.         gettime(h,m,s,c);
  134.         h1:=h;
  135.         m1:=m;
  136.         s1:=s;
  137.         c1:=c;
  138.         b:=((c1+s1*100+m1*6000+h1*360000)+8640000-a) mod 8640000;
  139.     until (b>time);
  140.     end;
  141.  
  142.  
  143. (* Follow the common procedures based on interrupt $33 *)
  144.  
  145. procedure mousereset;
  146. var regs : REGISTERS;
  147.    begin
  148.    regs.ax:=0;
  149.    intr($33,regs);
  150.    end;
  151.  
  152. procedure showmouse;
  153. var regs : REGISTERS;
  154.    begin
  155.    regs.ax:=1;
  156.    intr($33,regs);
  157.    end;
  158.  
  159. procedure hidemouse;
  160. var regs : REGISTERS;
  161.    begin
  162.    regs.ax:=2;
  163.    intr($33,regs);
  164.    end;
  165.  
  166. function mouseclick:integer;
  167. var regs : REGISTERS;
  168.    begin
  169.    regs.ax:=3;
  170.    regs.bx:=0;
  171.    intr($33,regs);
  172.    mouseclick:=regs.bx;
  173.    end;
  174.  
  175. procedure mousecoords(var x,y : integer);
  176. var regs : REGISTERS;
  177.    begin
  178.     regs.ax:=3;
  179.     regs.bx:=0;
  180.    intr($33,regs);
  181.    x:=regs.cx shr 1;
  182.    y:=regs.dx;
  183.    end;
  184.  
  185. procedure mouse_x_limit(mn,mx : integer);
  186. var regs : REGISTERS;
  187.    begin
  188.     regs.ax:=7;
  189.     regs.cx:=mn;
  190.     regs.dx:=mx;
  191.    intr($33,regs);
  192.    end;
  193.  
  194. procedure mouse_y_limit(mn,mx : integer);
  195. var regs : REGISTERS;
  196.    begin
  197.     regs.ax:=8;
  198.     regs.cx:=mn;
  199.     regs.dx:=mx;
  200.    intr($33,regs);
  201.    end;
  202.  
  203. procedure mousemove(x,y : integer);
  204. var regs : REGISTERS;
  205.    begin
  206.     regs.ax:=4;
  207.     regs.cx:=x;
  208.     regs.dx:=y;
  209.    intr($33,regs);
  210.    end;
  211.  
  212. end.
  213.  
  214.  
  215.  
  216.